home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The PC-SIG Library 9
/
The PC-SIG Library on CD ROM - Ninth Edition.iso
/
301_400
/
DISK0324
/
DISK0324.ZIP
/
PTOOLENT.INC
< prev
next >
Wrap
Text File
|
1985-02-21
|
20KB
|
522 lines
{ PTOOLENT.INC Copyright 1984 R D Ostrander Version 1.0
Ostrander Data Services
5437 Honey Manor Dr
Indianapolis IN 46241
This Turbo Pascal include file is a display and data entry tool. It Displays
a given String (or Character Array), Integer, or Real (Dollar) data field
in a given screen area and allows the operator to make changes via the
keyboard. It allows the operator to end the editting using many ending
keys and passes information about those keys to the calling program.
This program has been placed in the Public Domain by the author and copies
may be freely made for non-commercial, demonstration, or evaluation purposes.
Use of these subroutines in a program for sale or for commercial purposes in
a place of business requires a $20 fee be paid to the author at the address
above. Personal non-commercial users may also elect to pay the $20 fee to
encourage further development of this and similar programs. With payment you
will be able to receive update notices, diskettes and printed documentation
of this and other PTOOLs from Ostrander Data Services.
PTOOL, PTOOLxxx, PDEMO, and PDEMOxxx are Copyright Trademarks of
Ostrander Data Services.
Turbo Pascal is a Copyright of Borland International Inc.
Call format is:
Set Data <String, Integer, or Real> initial display value.
Set DataType <Char> type of edit.
Set DisplaySize <Integer> number of spaces for display.
Set DisplayDecimals <Integer> for Real numbers only.
Set ReturnCode <Integer> need not be set but must be a variable.
GoToXY (X, Y) to set the Display Area location.
PTOOLENT (Data, DataType, DisplaySize, DisplayDecimals, ReturnCode);
Examples: Var CustomerName : String [24];
ReturnCode : Integer;
Begin
CustomerName := ' ';
Gotoxy (1,1)
PTOOLENT (CustomerName, 'S', 24, 0, ReturnCode);
See companion program PDEMOENT.PAS for further examples.
Note that the DisplaySize must be > DisplayDecimals + 1.
Invalid data and cursor movements cause beeps to the operator.
Editting Keys are:
Left Arrow : Move cursor to left
Right Arrow : Move cursor to right
Ctrl-Left Arrow : Move cursor to 1st position
Ctrl-Right Arrow : Move cursor past last character
Tab : Move cursor right to next word
Shift-Tab : Move cursor left to previous word
Backspace : Erase character to left of cursor
Del : Erase character under cursor
Ctrl-E : Erase editting area
Ctrl-F : Fill field with character to left of cursor
Ctrl-X : Erase all characters from cursor on
Ctrl-L : Left justify data
Ctrl-R : Right justify data
Ctrl-S : Start Editting over
Ctrl-N or Ctrl-Q : Quit with no change in data
Ctrl-P : Retreive Previous data or Ctrl-E(rased) data
Ctrl-U : Change all data to Upper Case
Ctrl-D : Change all data to Lower Case
Ins : Toggle Insert function on/off
Alt-Numerics may be used to enter character graphics codes
Edit Return codes are:
0 = Esc
1 = C/R or Ctrl-N or Ctrl-Q
2 = (Filled Field)
3 = Ctrl-Break/Ctrl-C (if $C- not set)
16-26, 30-38, 44,50 = Alt-Alphabetics
59-68 = F1 - F10
71 = Home
72 = Up Arrow
73 = PgUp
79 = End
80 = Down Arrow
81 = PgDn
84-93 = Shift F1 - F10
94-103 = Ctrl F1 - F10
104-113 = Alt F1 - F10
114 = Ctrl-PrtSc
117 = Ctrl-End
118 = Ctrl-PgDn
119 = Ctrl-Home
132 = Ctrl-PgUp }
Procedure PTOOLENT
(Var
Data; { Data to Edit }
TypeData : Char; { Data Type - I = Integer }
{ R = Real }
{ S = String }
Size, { Display Size - 1 to 80 }
Decimals : Integer; { Number of Decimal Places }
Var
OutEndCode : Integer); { Output Ending Code }
Var
PassI : Integer absolute Data;
PassR : Real absolute Data;
PassS : String [80] absolute Data;
Ch : Char;
Ch2 : Char;
CurrS : String [80];
SaveS : String [80];
I : Integer;
J : Integer;
DispX : Integer;
DispY : Integer;
Done : Boolean;
ErrCode : Integer;
Dot : Char;
DisplayType : Char;
Const
InsertKey : Boolean = False;
PrevS : String [80] = 'No data available';
Function PowerOf (Number, Power : Integer) : Real;
Var
J : Integer;
Work : Real;
Begin
Work := Number;
For J := 1 to Power - 1 do
Work := Work * 10;
PowerOf := Work;
End;
Function LowCase (Ch : Char) : Char;
Begin
If Ord (Ch) in [65 .. 90] then
LowCase := Char (Ord (Ch) + 32)
else
LowCase := Ch;
End;
Procedure Beep;
Begin
Sound (880);
Delay (150);
NoSound;
End;
Procedure Display;
Begin
Gotoxy (DispX, DispY);
CurrS [0] := Char(Size);
Write (CurrS);
End;
Procedure AddASpace;
Begin
Insert (Dot, CurrS, Size + 1);
End;
Procedure LeftJustify;
Begin
For J := 1 to Size do
If CurrS [1] = Dot then
Begin
Delete (CurrS, 1, 1);
AddASpace;
End;
End;
Procedure InsertSwitch;
type
BiosCall = Record
Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
End;
XferArea = Record
Case Boolean of
True : (Lo, Hi : Byte);
False : (I : Integer);
End;
var
BiosRec : BiosCall;
XferRec : XferArea;
Upper, Lower : byte;
Procedure ChangeCursor;
Begin
XferRec.Lo := 0; {Get Current Mode}
XferRec.Hi := 15;
BiosRec.Ax := XferRec.I;
Intr(16,BiosRec);
XferRec.I := BiosRec.Ax;
If Odd (XferRec.Lo) = False then DisplayType := 'M'
else DisplayType := 'C';
XferRec.Lo := 0;
XferRec.Hi := 1;
BiosRec.Ax := XferRec.I;
If DisplayType = 'C' then
Begin
XferRec.Lo := 7;
If InsertKey = True then XferRec.Hi := 4
else XferRec.Hi := 6;
End
else
Begin
XferRec.Lo := 13;
If InsertKey = True then XferRec.Hi := 9
else XferRec.Hi := 12;
End;
BiosRec.Cx := XferRec.I;
Intr(16, BiosRec);
End;
Begin
If InsertKey = True then InsertKey := False
else InsertKey := True;
ChangeCursor;
End;
Label
DisplayPoint;
BEGIN
Dot := Char (250);
Done := False;
ErrCode := 0;
DispX := WhereX;
DispY := WhereY;
FillChar (CurrS, Size + 1, Dot);
Case TypeData of
'I' : If PassI <> 0 then Str (PassI:Size, CurrS);
'R' : If PassR <> 0 then Str (PassR:Size:Decimals, CurrS);
'S' : CurrS := PassS;
End; {Case}
If (TypeData = 'I') or (TypeData = 'R') then
For I := 1 to Size do
If CurrS [1] = ' ' then
Begin
Delete (CurrS, 1, 1);
AddASpace;
End;
For I := 1 to Size do
If CurrS [I] = ' ' then CurrS [I] := Dot;
CurrS [0] := Char (Size);
I := 1;
SaveS := CurrS;
DisplayPoint:
Display;
While NOT Done Do
Begin
If I < 1 then
Begin
I := 1;
Beep;
End;
If I > Size then
Begin
I := Size;
Beep;
End;
Gotoxy (DispX + I - 1, DispY);
Ch := Char(00);
Ch2 := Char(00);
Read (KBD, Ch);
If Keypressed then Read (KBD, Ch2);
If Ord(Ch) = 27 then
Case Ord(Ch2) of
{Back Tab } 15 :
Begin
I := I - 1;
While ((CurrS [I] = Dot) or
(CurrS [I] = '.'))
and (I > 1) do
I := I - 1;
While (CurrS [I] <> Dot)
and (CurrS [I] <> '.')
and (I > 1) do
I := I - 1;
If (CurrS [I] = Dot) or
(CurrS [I] = '.') then I := I + 1;
End;
{Left Arrow } 75 : I := I -1;
{Right Arrow } 77 : I := I +1;
{Ins } 82 : InsertSwitch;
{Del } 83 : Begin
Delete (CurrS, I, 1);
AddASpace;
Display;
End;
{Ctrl-LeftArrow } 115 : If I = 1 then Beep
else I := 1;
{Ctrl-RightArrow} 116 : Begin
I := Size;
While (CurrS [I] = Dot)
and (I > 0) do
I := I - 1;
If I < Size then
I := I + 1;
End;
else Begin
Done := True;
OutEndCode := Ord(Ch2);
End;
End {Case}
else
Begin
If Ord (Ch) = 32 then
Ch := Dot;
Case Ord(Ch) of
{Ctrl-C } 3 : Begin
Done := True;
OutEndCode := 3;
End;
{Ctrl-D } 4 : Begin
For J := 1 to Size do
CurrS [J] := LowCase (CurrS [J]);
Display;
End;
{Ctrl-E } 5 : Begin
PrevS := CurrS;
FillChar (CurrS [1], Size, Dot);
Display;
I := 1;
End;
{Ctrl-F } 6: Begin
If I > 1 then J := I - 1
else J := 1;
FillChar (CurrS [J + 1], Size - J,
CurrS [J]);
Display;
End;
{Backspace } 8 : If I > 1 then
Begin
Delete (CurrS, I - 1, 1);
AddASpace;
Display;
I := I - 1;
End
else Beep;
{Tab } 9 : Begin
While (CurrS [I] <> Dot)
and (CurrS [I] <> '.')
and (I < Size) do
I := I + 1;
While ((CurrS [I] = Dot) or
(CurrS [I] = '.'))
and (I < Size) do
I := I + 1;
End;
{Ctrl-L } 12 : Begin
LeftJustify;
Display;
I := 1;
End;
{C/R } 13 : Begin
Done := True;
OutEndCode := 1;
End;
{Ctrl-N } 14 : Begin
CurrS := SaveS;
Done := True;
OutEndCode := 1;
End;
{Ctrl-P } 16 : Begin
For I := 1 to Size do
CurrS [I] := PrevS [I];
I := 1;
Display;
End;
{Ctrl-Q } 17 : Begin
CurrS := SaveS;
Done := True;
OutEndCode := 1;
End;
{Ctrl-R } 18 : Begin
I := Size;
While (CurrS [I] = Dot)
and (I > 0) do
I := I - 1;
If I < Size then
Begin
J := Size - I;
For I := 1 to J do
Insert (Dot, CurrS, 1);
End;
I := 1;
While CurrS [I] = Dot do
I := I + 1;
Display
End;
{Ctrl-S } 19 : Begin
CurrS := SaveS;
I := 1;
Goto DisplayPoint;
End;
{Ctrl-U } 21 : Begin
For J := 1 to Size do
CurrS [J] := UpCase (CurrS [J]);
Display;
End;
{Ctrl-X } 24 : Begin
FillChar (CurrS [I], Size - I + 1,
Dot);
Display;
End;
else If InsertKey = False then
Begin
Write (Ch);
CurrS [I] := Ch;
I := I + 1;
If I > Size then
Begin
Done := True;
OutEndCode := 2;
End;
End
else
Begin
Insert (Ch, CurrS, I);
I := I + 1;
Display;
If I > Size then
Begin
Done := True;
OutEndCode := 2;
End;
End;
End; {Case}
End;
End;
If (TypeData = 'I')
or (TypeData = 'R') then
Begin
LeftJustify;
I := 1;
While (CurrS [I] <> Dot)
and (I <= Size) do
I := I + 1;
For J := I to Size do
If CurrS [J] <> Dot then
Begin
Beep;
I := J - 1;
Done := False;
Goto DisplayPoint;
End;
CurrS [0] := Char (I - 1);
End;
If InsertKey = True then InsertSwitch;
ErrCode := 0;
If TypeData = 'I' then
Val (CurrS, PassI, ErrCode);
If TypeData = 'R' then
Begin
Val (CurrS, PassR, ErrCode);
If Decimals > 0 then
Begin
If (PassR >= PowerOf (10, Size - Decimals - 1))
or (PassR <= PowerOf (10, Size - Decimals - 2) * -1) then
Begin
Beep;
I := 1;
Done := False;
Goto DisplayPoint;
End;
End;
End;
If ErrCode <> 0 then
Begin
Beep;
Done := False;
I := ErrCode;
Goto DisplayPoint;
End;
If TypeData = 'S' then
Begin
For I := 1 to Size do
If CurrS [I] = Dot then CurrS [I] := ' ';
CurrS [0] := Char (Size);
PassS := CurrS;
End;
FillChar (PrevS, 80, Dot);
PrevS := CurrS;
Gotoxy (DispX, DispY);
Case TypeData of
'S' : Write (PassS);
'I' : Write (PassI:Size);
'R' : Write (PassR:Size:Decimals);
End; {case}
Gotoxy (DispX, DispY);
END;
